Daniela Pinto Veizaga
En este ejemplos consideramos la red de aeropuertos de EU:
library(tidyverse)
library(tidygraph)
library(ggraph)
library(igraphdata)
data("USairports")
# ver detalles
# ?USairports
Nota que cada arista corresponde a una aerolÃnea (carrier) y tipo de avión (Aircraft), y los nodos son los aeropuertos. Los datos de las aristas corresponden a vuelos de Diciembre de 2010, y es una gráfica dirigida.
Sobre los datos:
| Vertex attributes | Description |
|---|---|
| name | Symbolic vertex name, this is the three letter IATA airport code. |
| City | City and state, where the airport is located. |
| Position | Position of the airport, in WGS coordinates. |
| Edge attributes | Description |
|---|---|
| Carrier | Name of the airline. The network includes both domestic and international carriers that performed at least one flight in December of 2010. |
| Departures | The number of departures (for a given airline and aircraft type. |
| Seats | The total number of seats available on the flights carried out by a given airline, using a given aircraft type. |
| Passengers | The total number of passangers on the flights carried out by a given airline, using a given aircraft type. |
| Aircraft | Type of the aircraft. |
| Distance | The distance between the two airports, in miles. |
airports <- USairports %>% as_tbl_graph()
airports
[38;5;246m# A tbl_graph: 755 nodes and 23473 edges
[39m[38;5;246m#
[39m[38;5;246m# A directed multigraph with 6 components
[39m[38;5;246m#
[39m[38;5;246m# Node Data: 755 x 3 (active)[39m
name City Position
[3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m
[38;5;250m1[39m BGR Bangor, ME N444827 W0684941
[38;5;250m2[39m BOS Boston, MA N422152 W0710019
[38;5;250m3[39m ANC Anchorage, AK N611028 W1495947
[38;5;250m4[39m JFK New York, NY N403823 W0734644
[38;5;250m5[39m LAS Las Vegas, NV N360449 W1150908
[38;5;250m6[39m MIA Miami, FL N254736 W0801726
[38;5;246m# … with 749 more rows[39m
[38;5;246m#
[39m[38;5;246m# Edge Data: 23,473 x 8[39m
from to Carrier Departures Seats Passengers Aircraft Distance
[3m[38;5;246m<int>[39m[23m [3m[38;5;246m<int>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<dbl>[39m[23m [3m[38;5;246m<dbl>[39m[23m [3m[38;5;246m<dbl>[39m[23m [3m[38;5;246m<int>[39m[23m [3m[38;5;246m<dbl>[39m[23m
[38;5;250m1[39m 1 4 British… 1 226 193 627 382
[38;5;250m2[39m 1 4 British… 1 299 253 819 382
[38;5;250m3[39m 2 7 British… 1 216 141 627 200
[38;5;246m# … with 2.347e+04 more rows[39m
En total son 755 aeropuertos y 23,473 tipos aerolÃneas y tipos de aviones.
Esta gŕafica es un multigrafo (puede haber varias aristas con la misma dirección en un par de nodos).
Nos interesa en primer lugar agregar a un grafo, y considerar el total de pasajeros (puedes también considerar número de asientos, por ejemplo) que viajó entre cada par de aeropuertos. Podemos agregar de las siguiente forma:
# seleccionamos solo pasajeros
vertices <- airports %>%
activate(edges) %>%
select(to, from, Passengers) %>% as_tibble()
# agregar
vertices_agregados <- vertices %>%
group_by(to, from) %>%
summarise(pax = sum(Passengers))
# nodos, y agregar estado
nodos <- airports %>% activate(nodes) %>%
as_tibble() %>%
separate(City, into = c('ciudad_nombre', 'estado'), sep = ', ')
# construir nueva red
aeropuertos <- tbl_graph(nodes = nodos, edges = vertices_agregados)
aeropuertos
[38;5;246m# A tbl_graph: 755 nodes and 8265 edges
[39m[38;5;246m#
[39m[38;5;246m# A directed multigraph with 6 components
[39m[38;5;246m#
[39m[38;5;246m# Node Data: 755 x 4 (active)[39m
name ciudad_nombre estado Position
[3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m
[38;5;250m1[39m BGR Bangor ME N444827 W0684941
[38;5;250m2[39m BOS Boston MA N422152 W0710019
[38;5;250m3[39m ANC Anchorage AK N611028 W1495947
[38;5;250m4[39m JFK New York NY N403823 W0734644
[38;5;250m5[39m LAS Las Vegas NV N360449 W1150908
[38;5;250m6[39m MIA Miami FL N254736 W0801726
[38;5;246m# … with 749 more rows[39m
[38;5;246m#
[39m[38;5;246m# Edge Data: 8,265 x 3[39m
from to pax
[3m[38;5;246m<int>[39m[23m [3m[38;5;246m<int>[39m[23m [3m[38;5;246m<dbl>[39m[23m
[38;5;250m1[39m 2 1 2
[38;5;250m2[39m 4 1 35
[38;5;250m3[39m 6 1 3
[38;5;246m# … with 8,262 more rows[39m
# seleccionamos solo asientos
vertices <- airports %>%
activate(edges) %>%
select(to, from, Seats) %>% as_tibble()
# agregar
vertices_agregados <- vertices %>%
group_by(to, from) %>%
summarise(pax = sum(Seats))
# nodos, y agregar estado
nodos <- airports %>% activate(nodes) %>%
as_tibble() %>%
separate(City, into = c('ciudad_nombre', 'estado'), sep = ', ')
# construir nueva red
aeropuertos <- tbl_graph(nodes = nodos, edges = vertices_agregados)
aeropuertos
[38;5;246m# A tbl_graph: 755 nodes and 8265 edges
[39m[38;5;246m#
[39m[38;5;246m# A directed multigraph with 6 components
[39m[38;5;246m#
[39m[38;5;246m# Node Data: 755 x 4 (active)[39m
name ciudad_nombre estado Position
[3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m
[38;5;250m1[39m BGR Bangor ME N444827 W0684941
[38;5;250m2[39m BOS Boston MA N422152 W0710019
[38;5;250m3[39m ANC Anchorage AK N611028 W1495947
[38;5;250m4[39m JFK New York NY N403823 W0734644
[38;5;250m5[39m LAS Las Vegas NV N360449 W1150908
[38;5;250m6[39m MIA Miami FL N254736 W0801726
[38;5;246m# … with 749 more rows[39m
[38;5;246m#
[39m[38;5;246m# Edge Data: 8,265 x 3[39m
from to pax
[3m[38;5;246m<int>[39m[23m [3m[38;5;246m<int>[39m[23m [3m[38;5;246m<dbl>[39m[23m
[38;5;250m1[39m 2 1 34
[38;5;250m2[39m 4 1 50
[38;5;250m3[39m 6 1 12
[38;5;246m# … with 8,262 more rows[39m
Podemos también filtrar opcionalmente aquellas conexiones que tengan un número de pasajeros bajo durante el mes de observación. La distribución de pasajeros podemos examinarla con:
pasajeros <- aeropuertos %>% activate(edges) %>%
select(from, to , pax)
quantile(pull(pasajeros, pax), seq(0, 1, 0.1))
0% 10% 20% 30% 40% 50% 60%
3.0 38.0 127.8 330.2 1350.0 2750.0 4289.0
70% 80% 90% 100%
7149.4 11737.2 23455.8 180407.0
corte_pax <- 100
aero_grandes <- aeropuertos %>% activate(edges) %>%
filter(pax > corte_pax) %>%
activate(nodes) %>%
filter(!node_is_isolated()) #eliminar nodos que quedan sin conexiones
Haz una primera gráfica (checa también como colorear según una variable de nodos):
aero_grandes %>%
activate(nodes) %>%
mutate(color_ca = ifelse(estado == "CA", "CA", "Otros")) %>%
ggraph(layout = 'fr', niter = 2000) +
geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") +
geom_node_point(aes(colour = color_ca)) +
theme_graph()
Pregunta 1: cuántas componentes tiene esta gráfica (tip: haz un mutate con la función group_components)
Esta gráfica cuenta con 8 componentes.
aero_grandes %>%
activate(nodes) %>%
mutate(group = group_components())
[38;5;246m# A tbl_graph: 640 nodes and 6743 edges
[39m[38;5;246m#
[39m[38;5;246m# A directed multigraph with 7 components
[39m[38;5;246m#
[39m[38;5;246m# Node Data: 640 x 5 (active)[39m
name ciudad_nombre estado Position group
[3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<int>[39m[23m
[38;5;250m1[39m BGR Bangor ME N444827 W0684941 1
[38;5;250m2[39m BOS Boston MA N422152 W0710019 1
[38;5;250m3[39m ANC Anchorage AK N611028 W1495947 1
[38;5;250m4[39m JFK New York NY N403823 W0734644 1
[38;5;250m5[39m LAS Las Vegas NV N360449 W1150908 1
[38;5;250m6[39m MIA Miami FL N254736 W0801726 1
[38;5;246m# … with 634 more rows[39m
[38;5;246m#
[39m[38;5;246m# Edge Data: 6,743 x 3[39m
from to pax
[3m[38;5;246m<int>[39m[23m [3m[38;5;246m<int>[39m[23m [3m[38;5;246m<dbl>[39m[23m
[38;5;250m1[39m 41 1 200
[38;5;250m2[39m 42 1 [4m2[24m800
[38;5;250m3[39m 55 1 [4m6[24m140
[38;5;246m# … with 6,740 more rows[39m
aero_grandes
[38;5;246m# A tbl_graph: 640 nodes and 6743 edges
[39m[38;5;246m#
[39m[38;5;246m# A directed multigraph with 7 components
[39m[38;5;246m#
[39m[38;5;246m# Node Data: 640 x 4 (active)[39m
name ciudad_nombre estado Position
[3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m
[38;5;250m1[39m BGR Bangor ME N444827 W0684941
[38;5;250m2[39m BOS Boston MA N422152 W0710019
[38;5;250m3[39m ANC Anchorage AK N611028 W1495947
[38;5;250m4[39m JFK New York NY N403823 W0734644
[38;5;250m5[39m LAS Las Vegas NV N360449 W1150908
[38;5;250m6[39m MIA Miami FL N254736 W0801726
[38;5;246m# … with 634 more rows[39m
[38;5;246m#
[39m[38;5;246m# Edge Data: 6,743 x 3[39m
from to pax
[3m[38;5;246m<int>[39m[23m [3m[38;5;246m<int>[39m[23m [3m[38;5;246m<dbl>[39m[23m
[38;5;250m1[39m 41 1 200
[38;5;250m2[39m 42 1 [4m2[24m800
[38;5;250m3[39m 55 1 [4m6[24m140
[38;5;246m# … with 6,740 more rows[39m
Return value of group_component: a numeric vector with the membership for each node in the graph. The enumeration happens in order based on group size progressing from the largest to the smallest group
Pregunta 2: prueba otro layout: kk o graphopt, por ejemplo. ¿Puedes reconocer estructuras distintas? ¿Qué método parece funcionar mejor?
aero_grandes %>%
activate(nodes) %>%
#mutate(color_ca = ifelse(estado == "LA", "LA", "Otros")) %>%
ggraph(layout = 'kk') +
geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") +
geom_node_point(aes(colour =estado)) +
theme_graph()
aero_grandes %>%
activate(nodes) %>%
mutate(color_ca = ifelse(estado == "CA", "CA", "Otros")) %>%
ggraph(layout = 'graphopt') +
geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") +
geom_node_point(aes(colour = color_ca)) +
theme_graph()
Filtra la componente conexa más grande:
aero <- aero_grandes %>%
activate(nodes) %>%
mutate(component = group_components()) %>%
filter(component == 1)
Calcula intermediación:
aero <- aero %>% activate(nodes) %>%
mutate(intermediacion = centrality_betweenness())
aero
[38;5;246m# A tbl_graph: 622 nodes and 6719 edges
[39m[38;5;246m#
[39m[38;5;246m# A directed multigraph with 1 component
[39m[38;5;246m#
[39m[38;5;246m# Node Data: 622 x 6 (active)[39m
name ciudad_nombre estado Position component intermediacion
[3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<chr>[39m[23m [3m[38;5;246m<int>[39m[23m [3m[38;5;246m<dbl>[39m[23m
[38;5;250m1[39m BGR Bangor ME N444827 W0684… 1 24.5
[38;5;250m2[39m BOS Boston MA N422152 W0710… 1 [4m1[24m[4m6[24m681.
[38;5;250m3[39m ANC Anchorage AK N611028 W1495… 1 [4m1[24m[4m3[24m[4m2[24m163.
[38;5;250m4[39m JFK New York NY N403823 W0734… 1 [4m1[24m[4m1[24m712.
[38;5;250m5[39m LAS Las Vegas NV N360449 W1150… 1 [4m1[24m[4m4[24m030.
[38;5;250m6[39m MIA Miami FL N254736 W0801… 1 [4m3[24m410.
[38;5;246m# … with 616 more rows[39m
[38;5;246m#
[39m[38;5;246m# Edge Data: 6,719 x 3[39m
from to pax
[3m[38;5;246m<int>[39m[23m [3m[38;5;246m<int>[39m[23m [3m[38;5;246m<dbl>[39m[23m
[38;5;250m1[39m 41 1 200
[38;5;250m2[39m 42 1 [4m2[24m800
[38;5;250m3[39m 55 1 [4m6[24m140
[38;5;246m# … with 6,716 more rows[39m
Pregunta 3: ¿cuáles son los aeropuertos con intermediación más grande? (convierte el objeto de la gráfica a tibble después de activar nodos).
aero %>% activate(nodes) %>%
mutate(intermediacion = centrality_betweenness()) %>%
as_tibble() %>%
arrange(desc(intermediacion))%>%
head()
| Ciudad | Estado | Intermediación |
|---|---|---|
| Anchorage | AK-Alaska | 86686 |
| Denver | CO-Colorado | 35444 |
| Minneapolis | MN- Minnesota | 33674 |
| Bethel | AK-Alaska | 31412 |
| Seattle | WA-Washington | 30286 |
Ahora haz una gráfica coloreando con un estado relevante (considera tu respuesta de la pregunta anterior) y usando la intermediación como tamaño:
aero %>%
activate(nodes) %>%
mutate(color_edo = ifelse(estado == "AK", "AK", "Otros")) %>%
ggraph(layout = 'fr', niter=2000) +
geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") +
geom_node_point(aes(size = intermediacion, colour=color_edo)) +
theme_graph()
Pregunta 4 Explica el nodo con mayor intermediación de la gráfica. ¿Qué conecta?
Es uno de los nodos (Anchorage) que conecta a Alaska con el resto de los Estados; existe otro nodo (Bethel) que también conecta a Alaska con el resto de los Estados.
Calcula centralidad de eigenvector, y ahora usa tamaño para esta centralidad y color para intermediación
aero<- aero %>%
activate(nodes) %>%
mutate(central_eigen = centrality_eigen())
aero %>%
activate(nodes) %>%
mutate(central_eigen = centrality_eigen()) %>%
as_tibble() %>%
arrange(desc(central_eigen))%>%
head()
Pregunta 5 ¿Cuáles son los aeropuertos con mayor centralidad de eigenvector? Contrasta con intermediación.
| ciudad_nombre | estado | intermediacion | central_eigen |
|---|---|---|---|
| Atlanta | GA-Georgia | 26290.09 | 1.0000000 |
| Chicago | IL-Illinois | 29361.47 | 0.9840030 |
| Dallas/Ft.Worth | TX-Texas | 20743.55 | 0.9230075 |
| Denver | CO-Colorado | 35444.43 | 0.9131323 |
| Minneapolis | MN-Minnesota | 33673.76 | 0.9082336 |
| Detroit | MI-Michigan | 17181.70 | 0.8987680 |
Elimina los aeropuertos de Alaska y vuelve a graficar, esta vez usando centralidad de eigenvector para color y tamaño.
aero %>%
activate(nodes) %>%
filter(estado!="AK") %>%
ggraph(layout = 'graphopt', spring.constant = 0.25, charge = 0.05, niter = 300) +
geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") +
geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
theme_graph()
Pregunta 6: ¿calcular centralidad y luego filtrar nodos es lo mismo que filtrar nodos y luego calcular centralidad?
No, no es lo mismo por la forma en cómo se calcula la centralidad y la identificación de los nodos que toma en cuenta para el cálculo.
Pregunta 7: experimenta con los parámetros del layout (por ejemplo, los 2 que se usan arriba). ¿Cómo obtienes mejores resultados?
aero %>%
activate(nodes) %>%
filter(estado!="AK") %>%
ggraph(layout = 'graphopt', spring.constant = 0.95, charge = 0.05, niter = 300) +
geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") +
geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
theme_graph()
aero %>%
activate(nodes) %>%
filter(estado!="AK") %>%
ggraph(layout = 'graphopt', spring.constant = 0.25, charge = 0.95, niter = 300) +
geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") +
geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
theme_graph()
aero %>%
activate(nodes) %>%
filter(estado!="AK") %>%
ggraph(layout = 'graphopt', spring.constant = 0.5, charge = 0.5, niter = 300) +
geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") +
geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
theme_graph()
Pregunta 8 (más difÃcil): etiqueta los nodos. Etiqueta solo los nodos que tengan centralidad de eigenvector alta. Puedes experimentar (layout, colores, tamaño de texto) con este código:
aero %>%
activate(nodes) %>%
filter(estado!="AK") %>%
ggraph(layout = 'graphopt', spring.constant = 0.25, charge = 0.05, niter = 300) +
geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") +
geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
geom_node_text(aes(label = name, alpha = central_eigen>0.8987679), repel = TRUE, size = 3, color = "black") +
theme_graph()